home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gsdbloo.exe / DEMO_CMN.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-21  |  7KB  |  178 lines
  1. program DEMO_CMN;
  2. {------------------------------------------------------------------------------
  3.                   Griffin Solutions String and Date Features
  4.                                  Demo Program
  5.  
  6.        Copyright (c)  Richard F. Griffin
  7.  
  8.        10 February 1992
  9.  
  10.        102 Molded Stone Pl
  11.        Warner Robins, GA  31088
  12.  
  13.        -------------------------------------------------------------
  14.        This program demonstrates how string and date values may be
  15.        accessed using Griffin Solutions units.
  16.  
  17.        ------
  18.  
  19.        Date field operations are performed in the GS_DATE.PAS unit.
  20.        This provides a longint julian date, a string in MM/DD/YY
  21.        format, and a dBase Date field format YYYYMMDD.
  22.  
  23.        An astronomers' Julian day number is a calendar system which is
  24.        useful over a very large span of time.  (January 1, 1988 A.D. is
  25.        2,447,162 in this system.)  The valid range of dates allowed is
  26.        March 1, 0000 through December 31, 65535.
  27.  
  28.        By assigning a longint julian date, computing differences between
  29.        dates, adding days to an existing date, and other mathematical
  30.        actions become much easier.
  31.  
  32.        A GS_Date_Century flag may be set.  When true, the GS_Date_View
  33.        function will return MM/DD/YYYY.  When false, only the last two
  34.        digits of the year will be returned (MM/DD/YY).  The default is false.
  35.  
  36.        ------
  37.  
  38.        The following string-handling routines are available in GS_STRNG.PAS:
  39.  
  40.            function AllCaps(var t : string) : string;
  41.                                        Sets string to upper case.
  42.  
  43.            procedure CnvAscToStr(var asc, st; lth : integer);
  44.                                        Copies ZASCII field to a string
  45.  
  46.            procedure CnvStrToAsc(var st, asc; lth : integer);
  47.                                        Copies string to a ZASCII field
  48.  
  49.            function StrDate(jul : longint) : string;
  50.                                        Converts a julian date to a string
  51.                                        in MM/DD/YY (or MM/DD/YYYY) format.
  52.  
  53.            function StrNumber(num : real; lth,dec : integer) : string;
  54.                                        Converts a real number to a string
  55.  
  56.            function StrLogic(tf : boolean) : string;
  57.                                        Converts a boolean value to a string
  58.                                        value of 'T' or 'F'
  59.  
  60.            function Strip_Flip(st : string) : string;
  61.                                        Removes trailing spaces and moves any
  62.                                        part of the string that is preceeded
  63.                                        by a '~' to the end of the string.
  64.                                        For Example:
  65.                                            Smith~John X.
  66.                                               will be converted to:
  67.                                                  John X. Smith
  68.  
  69.            function SubStr(s : string; b,l : integer) : string;
  70.                                        Returns a substring of the string s
  71.  
  72.            function TrimL(strn : string):string;
  73.                                        Deletes leading spaces
  74.  
  75.            function TrimR(strn : string):string;
  76.                                        Deletes trailing spaces
  77.  
  78.            function Unique_Field : string;
  79.                                        Used to create a unique 8-byte string
  80.                                        First character is alpha and others
  81.                                        are alpha(uppercase) or numeric.
  82.  
  83.            function ValDate(strn : string) : longint;
  84.                                        Converts a date string of either
  85.                                        MM/DD/YY or YYYYMMDD to the longint
  86.                                        julian day.
  87.  
  88.            function ValNumber(strn : string) : real;
  89.                                        Converts a string to a real number.
  90.                                        Returns 0 for invalid string;
  91.  
  92.            function ValLogic(strn : string) : boolean;
  93.                                        Creates a boolean value based on the
  94.                                        string.  If strn[1] is Y,y,T, or t
  95.                                        then it will return true; otherwise
  96.                                        it will return false.
  97.  
  98. -------------------------------------------------------------------------------}
  99. {$V-}
  100. uses
  101.    CRT,
  102.    GS_Date,
  103.    GS_Strng;
  104.  
  105. var
  106.    RealValue  : real;
  107.    LogicValue : boolean;
  108.    DateValue  : longint;
  109.    LogicString,
  110.    RealString,
  111.    Str1String,
  112.    Str2String,
  113.    UniqString,
  114.    DateString : string[20];
  115.    ZASCII     : array[0..20] of char;
  116.    i          : integer;
  117.  
  118. begin
  119.    ClrScr;
  120.    Str1String := '  Smith~John    ';
  121.    writeln('Original input -->':30,Str1String,'<--');
  122.  
  123.    writeln('UpperCase -->':30,AllCaps(Str1String),'<--');
  124.  
  125.    CnvStrToAsc(Str1String, ZASCII, sizeof(ZASCII));
  126.    write('ZASCII String -->':30);
  127.    i := 0;
  128.    while ZASCII[i] <> #0 do
  129.    begin
  130.       write(ZASCII[i]);
  131.       inc(i);
  132.    end;
  133.    writeln('<--');
  134.  
  135.    CnvAscToStr(ZASCII, Str2String, i);
  136.    writeln('Pascal String from ZASCII -->':30,Str2String,'<--');
  137.  
  138.    Str1String := TrimL(Str1String);
  139.    writeln('Trim Leading Spaces -->':30,Str1String,'<--');
  140.  
  141.    Str1String := TrimR(Str1String);
  142.    writeln('Trim Trailing Spaces -->':30,Str1String,'<--');
  143.  
  144.    writeln('Substring Chars 3-8 -->':30,SubStr(Str1String,3,6),'<--');
  145.  
  146.    writeln('Flip String at ~ -->':30,Strip_Flip(Str1String),'<--');
  147.  
  148.    writeln('Get Unique Field -->':30,Unique_Field,'<--');
  149.  
  150.    DateString := '02/28/1992';
  151.    DateValue := ValDate(DateString);
  152.    writeln('Julian Date for 02/28/1992 -->':30,DateValue,'<--');
  153.  
  154.    GS_Date_Century := false;
  155.    writeln('Date+90 Days (Century Off) -->':30,StrDate(DateValue+90),'<--');
  156.  
  157.    GS_Date_Century := true;
  158.    writeln('Date+90 Days (Century On)  -->':30,StrDate(DateValue+90),'<--');
  159.  
  160.    RealValue := 123.456;
  161.    writeln('Value 123.456 w/ $ edit -->':30,'$',StrNumber(RealValue,6,2),'<--');
  162.  
  163.    RealString := StrNumber(RealValue + 78.9,9,4);
  164.    writeln('String of 123.456 + 78.9 -->':30,RealString,'<--');
  165.  
  166.    writeln('Real of String/2   -->':30,ValNumber(RealString)/2,'<--');
  167.    writeln('Formatted String/2   -->':30,ValNumber(RealString)/2:7:4,'<--');
  168.  
  169.    LogicValue := true;
  170.    LogicString :=  StrLogic(LogicValue);
  171.    writeln('Logic string for true -->':30,LogicString,'<--');
  172.  
  173.    writeln('Logic boolean for true -->':30,ValLogic(LogicString),'<--');
  174.  
  175.    write('Press any key to continue:');
  176.    repeat until KeyPressed;
  177. end.
  178.